Files |  Tutorials |  Articles |  Links |  Home |  Team |  Forum |  Wiki |  Impressum

Aktuelle Zeit: Do Jul 03, 2025 10:04

Foren-Übersicht » Programmierung » Allgemein 		Unbeantwortete Themen | Aktive Themen


Ein neues Thema erstellen Auf das Thema antworten  Seite 2 von 2
  [ 18 Beiträge ]  Gehe zu Seite Vorherige  1, 2
  Vorheriges Thema | Nächstes Thema 
Autor Nachricht
LarsMiddendorf
 Betreff des Beitrags:
BeitragVerfasst: Sa Mär 29, 2003 12:57 
Offline
DGL Member
Benutzeravatar

Registriert: Sa Dez 28, 2002 11:13
Beiträge: 2244
Falls du den Quelltext der VCL hast gibt es in der Unit graphics die Prozedur ReadIcon, die allerdings nur in der Unit verfügbar ist. Mit Hilfe dieser Prozedur lädt TIcon in TIcon.HandleNeeded das Icon von einem MemoryStream. Vielleich kannst du die Prozedur kopieren und statt des MemoryStreams den Filestream benutzen.
Nach oben
 Profil  
Mit Zitat antworten  
rochus
 Betreff des Beitrags:
BeitragVerfasst: Sa Mär 29, 2003 15:04 
Offline
DGL Member
Benutzeravatar

Registriert: So Dez 29, 2002 10:37
Beiträge: 251
Wohnort: Ulm
hier die readicon prozedur aus delphi6


Code:
  1.  
  2. procedure ReadIcon(Stream: TStream; var Icon: HICON; ImageCount: Integer;
  3.   StartOffset: Integer; const RequestedSize: TPoint; var IconSize: TPoint);
  4. type
  5.   PIconRecArray = ^TIconRecArray;
  6.   TIconRecArray = array[0..300] of TIconRec;
  7. var
  8.   List: PIconRecArray;
  9.   HeaderLen, Length: Integer;
  10.   BitsPerPixel: Word;
  11.   Colors, BestColor, C1, N, Index: Integer;
  12.   DC: HDC;
  13.   BI: PBitmapInfoHeader;
  14.   ResData: Pointer;
  15.   XorBits, AndBits: HBITMAP;
  16.   XorInfo, AndInfo: Windows.TBitmap;
  17.   XorMem, AndMem: Pointer;
  18.   XorLen, AndLen: Integer;
  19. (*
  20. var
  21.   P: PChar;
  22. begin
  23.   P := Pointer(Integer((Stream as TCustomMemoryStream).Memory) + Stream.Position);
  24. //  N := LookupIconIdFromDirectoryEx(Pointer(P), True, 0, 0, LR_DEFAULTCOLOR);
  25.   Icon := GDICheck(CreateIconFromResourceEx(
  26.     Pointer(P + PIconRec(P)^.DIBOffset - StartOffset),
  27.     PIconRec(P)^.DIBSize, True, $00030000, 0, 0, LR_DEFAULTCOLOR));
  28. end;
  29. *)
  30.  
  31.   function AdjustColor(I: Integer): Integer;
  32.   begin
  33.     if I = 0 then
  34.       Result := MaxInt
  35.     else
  36.       Result := I;
  37.   end;
  38.  
  39.   function BetterSize(const Old, New: TIconRec): Boolean;
  40.   var
  41.     NewX, NewY, OldX, OldY: Integer;
  42.   begin
  43.     NewX := New.Width - IconSize.X;
  44.     NewY := New.Height - IconSize.Y;
  45.     OldX := Old.Width - IconSize.X;
  46.     OldY := Old.Height - IconSize.Y;
  47.  &nbsp; &nbsp;Result := (Abs(NewX) <= Abs(OldX)) and ((NewX <= 0) or (NewX <= OldX)) and
  48.  &nbsp; &nbsp; &nbsp; (Abs(NewY) <= Abs(OldY)) and ((NewY <= 0) or (NewY <= OldY));
  49.  &nbsp;end;
  50.  
  51. begin
  52.  &nbsp;HeaderLen := SizeOf(TIconRec) * ImageCount;
  53.  &nbsp;List := AllocMem(HeaderLen);
  54.  &nbsp;try
  55.  &nbsp; &nbsp;Stream.Read(List^, HeaderLen);
  56.  &nbsp; &nbsp;if (RequestedSize.X or RequestedSize.Y) = 0 then
  57.  &nbsp; &nbsp;begin
  58.  &nbsp; &nbsp; &nbsp;IconSize.X := GetSystemMetrics(SM_CXICON);
  59.  &nbsp; &nbsp; &nbsp;IconSize.Y := GetSystemMetrics(SM_CYICON);
  60.  &nbsp; &nbsp;end
  61.  &nbsp; &nbsp;else
  62.  &nbsp; &nbsp; &nbsp;IconSize := RequestedSize;
  63.  &nbsp; &nbsp;DC := GetDC(0);
  64.  &nbsp; &nbsp;if DC = 0 then OutOfResources;
  65.  &nbsp; &nbsp;try
  66.  &nbsp; &nbsp; &nbsp;BitsPerPixel := GetDeviceCaps(DC, PLANES) * GetDeviceCaps(DC, BITSPIXEL);
  67.  &nbsp; &nbsp; &nbsp;if BitsPerPixel > 8 then
  68.  &nbsp; &nbsp; &nbsp; &nbsp;Colors := MaxInt
  69.  &nbsp; &nbsp; &nbsp;else
  70.  &nbsp; &nbsp; &nbsp; &nbsp;Colors := 1 shl BitsPerPixel;
  71.  &nbsp; &nbsp;finally
  72.  &nbsp; &nbsp; &nbsp;ReleaseDC(0, DC);
  73.  &nbsp; &nbsp;end;
  74.  
  75.  &nbsp; &nbsp;{ Find the image that most closely matches (<=) the current screen color
  76.  &nbsp; &nbsp; &nbsp;depth and the requested image size. &nbsp;}
  77.  &nbsp; &nbsp;Index := 0;
  78.  &nbsp; &nbsp;BestColor := AdjustColor(List^[0].Colors);
  79.  &nbsp; &nbsp;for N := 1 to ImageCount-1 do
  80.  &nbsp; &nbsp;begin
  81.  &nbsp; &nbsp; &nbsp;C1 := AdjustColor(List^[N].Colors);
  82.  &nbsp; &nbsp; &nbsp;if (C1 <= Colors) and (C1 >= BestColor) and
  83.  &nbsp; &nbsp; &nbsp; &nbsp;BetterSize(List^[Index], List^[N]) then
  84.  &nbsp; &nbsp; &nbsp;begin
  85.  &nbsp; &nbsp; &nbsp; &nbsp;Index := N;
  86.  &nbsp; &nbsp; &nbsp; &nbsp;BestColor := C1;
  87.  &nbsp; &nbsp; &nbsp;end;
  88.  &nbsp; &nbsp;end;
  89.  
  90.  &nbsp; &nbsp;{ the following code determines which image most closely matches the
  91.  &nbsp; &nbsp; &nbsp;current device. It is not meant to absolutely match Windows
  92.  &nbsp; &nbsp; &nbsp;(known broken) algorithm }
  93. (* &nbsp; &nbsp;C2 := 0;
  94.  &nbsp; &nbsp;for N := 0 to ImageCount - 1 do
  95.  &nbsp; &nbsp;begin
  96.  &nbsp; &nbsp; &nbsp;C1 := List^[N].Colors;
  97.  &nbsp; &nbsp; &nbsp;if C1 = Colors then
  98.  &nbsp; &nbsp; &nbsp;begin
  99.  &nbsp; &nbsp; &nbsp; &nbsp;Index := N;
  100.  &nbsp; &nbsp; &nbsp; &nbsp;if (IconSize.X = List^[N].Width) and (IconSize.Y = List^[N].Height) then
  101.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Break; &nbsp;// exact match on size and color
  102.  &nbsp; &nbsp; &nbsp;end
  103.  &nbsp; &nbsp; &nbsp;else if Index = -1 then
  104.  &nbsp; &nbsp; &nbsp;begin &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;// take the first icon with fewer colors than screen
  105.  &nbsp; &nbsp; &nbsp; &nbsp;if C1 <= Colors then
  106.  &nbsp; &nbsp; &nbsp; &nbsp;begin
  107.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Index := N;
  108.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;C2 := C1;
  109.  &nbsp; &nbsp; &nbsp; &nbsp;end;
  110.  &nbsp; &nbsp; &nbsp;end
  111.  &nbsp; &nbsp; &nbsp;else if C1 > C2 then &nbsp;// take icon with more colors than first match
  112.  &nbsp; &nbsp; &nbsp; &nbsp;Index := N;
  113.  &nbsp; &nbsp;end;
  114.  &nbsp; &nbsp;if Index = -1 then Index := 0;
  115. *)
  116.  &nbsp; &nbsp;with List^[Index] do
  117.  &nbsp; &nbsp;begin
  118.  &nbsp; &nbsp; &nbsp;IconSize.X := Width;
  119.  &nbsp; &nbsp; &nbsp;IconSize.Y := Height;
  120.  &nbsp; &nbsp; &nbsp;BI := AllocMem(DIBSize);
  121.  &nbsp; &nbsp; &nbsp;try
  122.  &nbsp; &nbsp; &nbsp; &nbsp;Stream.Seek(DIBOffset &nbsp;- (HeaderLen + StartOffset), 1);
  123.  &nbsp; &nbsp; &nbsp; &nbsp;Stream.Read(BI^, DIBSize);
  124.  &nbsp; &nbsp; &nbsp; &nbsp;TwoBitsFromDIB(BI^, XorBits, AndBits, IconSize);
  125.  &nbsp; &nbsp; &nbsp; &nbsp;GetObject(AndBits, SizeOf(Windows.TBitmap), @AndInfo);
  126.  &nbsp; &nbsp; &nbsp; &nbsp;GetObject(XorBits, SizeOf(Windows.TBitmap), @XorInfo);
  127.  &nbsp; &nbsp; &nbsp; &nbsp;with AndInfo do
  128.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;AndLen := bmWidthBytes * bmHeight * bmPlanes;
  129.  &nbsp; &nbsp; &nbsp; &nbsp;with XorInfo do
  130.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;XorLen := &nbsp;bmWidthBytes * bmHeight * bmPlanes;
  131.  &nbsp; &nbsp; &nbsp; &nbsp;Length := AndLen + XorLen;
  132.  &nbsp; &nbsp; &nbsp; &nbsp;ResData := AllocMem(Length);
  133.  &nbsp; &nbsp; &nbsp; &nbsp;try
  134.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;AndMem := ResData;
  135.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;with AndInfo do
  136.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;XorMem := Pointer(Longint(ResData) + AndLen);
  137.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;GetBitmapBits(AndBits, AndLen, AndMem);
  138.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;GetBitmapBits(XorBits, XorLen, XorMem);
  139.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;DeleteObject(XorBits);
  140.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;DeleteObject(AndBits);
  141.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Icon := CreateIcon(HInstance, IconSize.X, IconSize.Y,
  142.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;XorInfo.bmPlanes, XorInfo.bmBitsPixel, AndMem, XorMem);
  143.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;if Icon = 0 then GDIError;
  144.  &nbsp; &nbsp; &nbsp; &nbsp;finally
  145.  &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;FreeMem(ResData, Length);
  146.  &nbsp; &nbsp; &nbsp; &nbsp;end;
  147.  &nbsp; &nbsp; &nbsp;finally
  148.  &nbsp; &nbsp; &nbsp; &nbsp;FreeMem(BI, DIBSize);
  149.  &nbsp; &nbsp; &nbsp;end;
  150.  &nbsp; &nbsp;end;
  151.  &nbsp;finally
  152.  &nbsp; &nbsp;FreeMem(List, HeaderLen);
  153.  &nbsp;end;
  154. end;
  155.  

_________________
http://www.rochus.net
Nach oben
 Profil  
Mit Zitat antworten  
Aya
 Betreff des Beitrags:
BeitragVerfasst: Sa Apr 05, 2003 19:54 
Offline
DGL Member
Benutzeravatar

Registriert: Di Dez 03, 2002 22:12
Beiträge: 2105
Wohnort: Vancouver, Canada
Programmiersprache: C++, Python
Son of Satan hat geschrieben:
Was dadran jetzt so schwierig war ist mir schleierhaft... steht doch alles in Kid Paddles Dokument Wort für Wort drinne.An so'nem einfachen Dateiformat sollte man eigentlich nicht so schnell scheitern <_<

An so nem einfachen Format scheitert ein komplettes Forum :P
Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  Seite 2 von 2
  [ 18 Beiträge ]  Gehe zu Seite Vorherige  1, 2
Foren-Übersicht » Programmierung » Allgemein


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 4 Gäste

Du darfst keine neuen Themen in diesem Forum erstellen.
Du darfst keine Antworten zu Themen in diesem Forum erstellen.
Du darfst deine Beiträge in diesem Forum nicht ändern.
Du darfst deine Beiträge in diesem Forum nicht löschen.
Du darfst keine Dateianhänge in diesem Forum erstellen.

Suche nach:
Gehe zu:  
  Powered by phpBB® Forum Software © phpBB Group
Deutsche Übersetzung durch phpBB.de
[ Time : 0.013s | 15 Queries | GZIP : On ]