TPicture.RegisterFileFormat में पंजीकृत ग्राफिक कक्षाओं की सूची प्राप्त करें

नोट बताता है कि आप सभी पंजीकृत ग्राफिक कक्षाओं को निर्धारित करने के लिए डेल्फी में डिबगिंग मेमोरी मैनेजर का उपयोग कैसे कर सकते हैं।
सबसे पहले, एक संक्षिप्त परिचय जो लक्षित दर्शकों को ज्ञात चीजों का वर्णन करता है। लेकिन चूंकि परिचय होना चाहिए, तो होने दो।
डेल्फी वीसीएल में विभिन्न छवि प्रारूपों का समर्थन करने के लिए एक नियमित तंत्र है। एक TPicture वर्ग है जो विभिन्न प्रारूपों के चित्रों को लोड कर सकता है। वांछित ग्राफिक क्लास फ़ाइल एक्सटेंशन द्वारा निर्धारित किया जाता है।
ग्राफिक क्लास को TPicture.RegisterFileFormat कहकर पंजीकृत किया जाता है, जहां फ़ाइल एक्सटेंशन को स्थानांतरित किया जाता है और इसके अनुरूप वर्ग (उदाहरण के लिए, TPicture.RegisterFileFormat ('PNG', 'पोर्टेबल नेटवर्क ग्राफिक्स', TPNGObject); )
अगला, TPicture.LoadFromFile में एक चित्र लोड करते समय, इस फ़ाइल के विस्तार के लिए पंजीकृत वर्ग को खोजा जाता है। पाया वर्ग का एक उदाहरण बनाया गया है और यह पहले से ही फ़ाइल से चित्र लोड करता है।
बारीकियों यह है कि आप एक एक्सटेंशन के लिए कई कक्षाएं पंजीकृत कर सकते हैं। अंतिम उपयोग किया जाएगा। लेकिन यह निर्धारित करना कि कौन सा वर्ग अंतिम पंजीकृत है, यह हमेशा आसान नहीं होता है। भले ही सभी वर्ग परंपरागत रूप से अपने मॉड्यूल के प्रारंभ में पंजीकृत हैं। मॉड्यूल का प्रारंभिक क्रम हमेशा स्पष्ट नहीं होता है। और कुछ भी कोड में मॉड्यूल को इनिशियलाइज़ करने के बाद RegisterFileFormat को कॉल करने से रोकता है।
TPicture में पंजीकृत ग्राफिक कक्षाओं की सूची के साथ काम करने के लिए तंत्र छिपे हुए हैं और यह पता लगाने का कोई नियमित तरीका नहीं है कि कौन सा वर्ग एक विशिष्ट विस्तार के लिए पंजीकृत है। हालाँकि व्युत्क्रम समस्या का हल बस ग्राफिकएक्स्टेंशन कहकर किया जाता है। आप एक ब्याज प्रारूप की एक तस्वीर को एक TPicture उदाहरण में लोड कर सकते हैं और देख सकते हैं कि TPicture.Graphic में क्या वर्ग है।

Picture.LoadFromFile('c:\bla\bla\image.png'); Picture.Graphic.ClassName; 

सिद्धांत रूप में, व्यवहार में, यह परीक्षण या डिबगिंग के लिए पर्याप्त है। लेकिन मैं सोच रहा था कि रजिस्टरफिल्ममैनेट में पंजीकृत सभी कक्षाएं कैसे प्राप्त करें।
यह पता चला कि यह संभव है और गंदे हैक की भी आवश्यकता नहीं है।
आपको FastMM4 को प्रोजेक्ट से कनेक्ट करना होगा। और अधिक सूचनात्मकता के लिए इसे कॉन्फ़िगर करें (FastMM4Options.inc में FullDebugMode को सक्षम करें)। अधिक विस्तृत जानकारी के लिए FastMM4 में जोड़ें और फ़ंक्शन को मॉड्यूल इंटरफेस में स्थानांतरित करें।

 function GetStackTraceAsText(AReturnAddresses: PNativeUInt): string; var LErrorMessage: array[0..32767] of AnsiChar; LMsgPtr: PAnsiChar; begin LMsgPtr := LogStackTrace(AReturnAddresses, StackTraceDepth, @LErrorMessage[0]); inc(LMsgPtr); LMsgPtr^ := #0; Result := LErrorMessage; end; 

इसके अलावा, टिप्पणियों के साथ डेमो कोड, मुझे अतिरिक्त विवरण के बिना स्पष्ट उम्मीद है। समाधान का सार GetGraphClasses में वर्णित है।

 program LogRegisterFileFormat; {$APPTYPE CONSOLE} uses FastMM4, { FastMM4Options.inc   FullDebugModeCallBacks  FullDebugMode} SysUtils, Classes, Graphics, Jpeg, pngimage; var LastClassName: string; function GetClassCreateLine(AStack: string): string; {        } var P: Integer; L: Integer; R: Integer; begin P := Pos('.Create]', AStack); if P > 0 then begin L := P; while (L > 1) and (AStack[L] > #32) do dec(L); inc(L); R := P; while (R < Length(AStack)) and (AStack[R] > #32) do inc(R); Result := Copy(AStack, L, R - L); end else Result := AStack; end; procedure DoCustomMemFree(APHeaderFreedBlock: PFullDebugBlockHeader; AResult: Integer); {   } var LClass: TClass; begin {    } LClass := DetectClassInstance(@APHeaderFreedBlock.PreviouslyUsedByClass); if LClass <> nil then begin {  TGraphic   LastClassName       } if LClass.InheritsFrom(TGraphic) then begin LastClassName := LClass.ClassName; {     ,      } if APHeaderFreedBlock.AllocationStackTrace[0] <> 0 then LastClassName := LastClassName + ' ' + GetClassCreateLine(GetStackTraceAsText(@APHeaderFreedBlock.AllocationStackTrace)); end; end; end; function Fetch(var Value: string; const Delimiter: string): string; {    Value       .   Synapse,      } var P: Integer; begin P := Pos(Delimiter, Value); if P < 1 then begin Result := Value; Value := ''; end else begin Result := Copy(Value, 1, P - 1); Delete(Value, 1, P + Length(Delimiter)); end; Result := Trim(Result); Value := Trim(Value); end; procedure GetGraphClasses(const AStrings: TStrings); var Filters: string; FileMask: string; FileExt: string; Pic: TPicture; begin {     '*.png;*.jpg'} Filters := GraphicFileMask(TGraphicClass(TObject)); {     } FileMask := Fetch(Filters, ';'); while Length(FileMask) > 0 do begin Pic := TPicture.Create; FileExt := ExtractFileExt(FileMask); try try LastClassName := ''; {    } FastMM4.OnDebugFreeMemFinish := DoCustomMemFree; {               .    LoadFromFile,        .         DoCustomMemFree     } Pic.LoadFromFile(FileExt); {   -    ,  , ,  } if Pic.Graphic <> nil then AStrings.Add(FileMask + ' = ' + Pic.Graphic.ClassName); except {      .   LastClassName   .} AStrings.Add(FileMask + ' = ' + LastClassName); LastClassName := ''; end; finally FreeAndNil(Pic); FastMM4.OnDebugFreeMemFinish := nil; end; {       Filters} FileMask := Fetch(Filters, ';'); end; end; var Log: TStringList; begin Log := TStringList.Create; GetGraphClasses(Log); Log.SaveToFile(ParamStr(0) + '.log'); Log.Free; end.