Koden nedenfor er for en komponent som kan skape gjennomsiktige (formet) former ... Koden nedenfor er for en komponent som kan skape gjennomsiktige (formet) skjemaer ved hjelp av enten punktgrafikk eller kontroller, eller begge . Det er to måter å fortelle den komponenten hva du ønsker brukt som en maske: Tag innstilling (TransTag) eller en komponentliste der du bare sette inn komponent navn som en ny linje av text.There er enda en hendelse for å følge utviklingen av prosessen, når det er lang.For bildene er det en maske farge egenskap, er at den farge som vil være transparent.Use den Utfør metode for å gjøre det gjennomsiktig form. Når det er ikke mange bilder, er prosessen ganske raskt og du kan bruke den til å lage enda animasjonseffekter på din desktop.NOTE: for etableringen av Mask fra bilder komponenten tar hensyn til TImage component.unit TransMake; interfaceuses Windows, meldinger, SysUtils, klasser, Grafikk, kontroller, skjemaer, Dialoger, ExtCtrls -typen TProcessEvent = prosedyre (progress: longint) objekt; TBy = (TBTag, TBComponentList); TTransMake = klasse (TComponent) private {felleserklæringer} ITransTag: integer; ImageTrans: Boolske; ColorMask: TColor; region: hrgn; TransByV: TBy; ComponentListV: TStrings; fullitems: LongInt; FOnProgress: TProcessEvent; prosedyre DrawTransparent; Prosedyren ComponentListWrite (verdi: TStrings); Prosedyren SetTransBy (verdi: TBy); beskyttede {Beskyttede erklæringer} prosedyre DoOnProgress (progress: longint); dynamisk; offentlige {publc erklæringer} Prosedyre Utfør; Constructor Opprette (AOwner: TComponent); styre; publiserte {Publisert erklæringer} Eiendom TransTag: Integer lese ITransTag skrive ITransTag; Eiendom ImageRegion: boolean lese ImageTrans skrive ImageTrans; Eiendommen MaskColor: TColor lese ColorMask skrive ColorMask; Eiendommen TransBy: TBy lese TransByV skrive SetTransBy standard TBTag; Eiendommen ComponentList: TStrings lese ComponentListV skrive ComponentListWrite; Eiendommen OnProgress: TProcessEvent lese FOnProgress skrive FOnProgress; enden, prosedyre register, implementationprocedure TTransMake.DoOnProgress (progress: longint); begynne hvis tildelt (FonProgress) så TProcessEvent (FonProgress) (fremgang); end; prosedyre TTransMake.SetTransBy (Verdi: TBy), begynner TransByV: = verdi; end; prosedyren TTransMake.ComponentListWrite (verdi: TStrings), begynner ComponentListV.Assign (verdi); end; konstruktør TTransMake.Create (AOwner: TComponent); begynne arvet Opprette (AOwner); ComponentListV: = TStringList.Create; ComponentListV.Add ( 'Plasser komponentnavnene her.'); FullItems: = 0; end; prosedyre TTransMake.DrawTransparent; Var OForm: TForm; i, o, x, y, rx, ry: heltall; tr: Trect; tregion, imgregion: Hrgn; fortsette: boolean; TempBitmap: TBitmap; Rgn1, Rgn2: HRgn; Col, StartCol, Row, test: integer; Line: PByteArray; gjør, perc: integer; begynne OForm: = TForm (eieren); region: = 0; imgregion: = 0; rgn1: = 0; fullitems: = 0; gjør: = 0; perc: = 0; region: = createRectRgn (0,0,0,0); rgn1: = createRectRgn (0,0,0,0); OForm.visible: = false; OForm.BorderStyle: = bsNone; for i: = 0 til OForm.ComponentCount-en ikke starter hvis TransBy = TBTag så hvis (OForm.Components [i]) tag = TransTag deretter begynne fortsette. = true; fullitems: = fullitems + 1; slutt; hvis TransBy = TBComponentList deretter begynne hvis componentlistV.Count > 0 da for o: = 0 til componentlistv.Count-en ikke starter hvis (med store bokstaver ((OForm.Components [i]) navn) = store bokstaver (componentlistv.Strings [o]. )), og start fullitems: = fullitems + 1; slutt; slutt; slutt; slutt; for i: = 0 til OForm.ComponentCount-en ikke starter fortsette: = false; . Hvis TransBy = TBTag så hvis (OForm.Components [i]) tag = TransTag deretter begynne fortsette: = true; slutt; hvis TransBy = TBComponentList deretter begynne hvis componentlistV.Count > 0 da for o: = 0 til componentlistv.Count-en ikke starter hvis (med store bokstaver ((OForm.Components [i]) navn) = store bokstaver (componentlistv.Strings [o]. )), og start fortsette: = true; slutt; slutt; slutt; hvis fortsett deretter begynne hvis TCONTROL (OForm.components [i]). synlig da begynne if (OForm.components [i] er TImage) og ImageRegion deretter begynne med TImage (OForm.components [i]). picture.bitmap gjør begynne for . Row: = 0 til TImage (OForm.components [i]) picture.bitmap.height-en ikke starter Col: = 0; mens Col < . TImage (OForm.components [i]) picture.bitmap.Width ikke begynne stund (Col. ≪ TImage (OForm.components [i]) picture.bitmap.Width) og (Canvas.pixels [col, rad] = ColorMask ) gjør inc (Col); hvis Col > = TImage (OForm.components [i]) picture.bitmap.Width deretter Fortsett.; StartCol: = Col; while (Col. < TImage (OForm.components [i]) picture.bitmap.Width) og (Canvas.pixels [col, rad] < > ColorMask) gjør inc (Col); hvis Col > = TImage (OForm.components [i]) picture.bitmap.Width deretter Col:. = TImage (OForm.components [i]) picture.bitmap.Width;. hvis Rgn1 = 0 da Rgn1:... = CreateRectRgn (TImage (OForm.components [i]) venstre + StartCol, TImage (OForm.components [i]) top + Row, TImage (OForm.components [i]) venstre + . Col, TImage (OForm.components [i]) top + Row + 1) annet begynne Rgn2:.. = CreateRectRgn (TImage (OForm.components [i]) venstre + StartCol, TImage (OForm.components [i]) toppen + Row, TImage (OForm.components [i]) venstre + Col, TImage (OForm.components [i]) top + Row + 1)..; if (Rgn2 < > 0) så CombineRgn (Rgn1, Rgn1, Rgn2, RGN_OR); Deleteobject (Rgn2); slutt; slutt; slutt; slutt; gjør: = gjør + 1; perc: = round (100 * (gjør /fullitems)); DoOnProgress (perc); combinergn (region, region, rgn1, rgn_or); rgn1: = 0; ende ellers begynner tr: = TCONTROL (OForm.components [i]) BoundsRect;. tr.left: = tr.left; tr.Top:=tr.Top; tr.Right: = tr.Right; tr.Bottom: = tr.Bottom; Hvis region = 0 da region: = createRectRgn (tr.Left, tr.Top, tr.Right, tr.Bottom) ellers begynner tregion: = createRectRgn (tr.Left, tr.Top, tr.Right, tr.Bottom); gjør: = gjør + 1; perc: = round (100 * (gjør /fullitems)); DoOnProgress (perc); combinergn (region, region, tregion, rgn_or); deleteObject (tregion); slutt; slutt; slutt; slutt; slutt; setwindowrgn (OForm.handle, region, true); OForm.visible: = true; ende; Prosedyre TTransMake.Execute, begynne DrawTransparent; ende; prosedyre Register, begynner RegisterComponents ( 'VNPVcls', [TTransMake]); end; slutten
.